{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit ActionManager;

interface

uses Classes, SyncObjs, BaseControls, Actions, Functions, KeyBindings, AHMTypes;

const
  MAX_KEYCODE = 255;
  UNMAPPED_KEYCODE = 0;
  KEYNAME_SEPARATOR = '||';

type
  TAHMKeyBinding = class
  private
    FName: String;
    FDisplayText: String;
    FKeyCode: Word;
  protected
  public
    property Name: String read FName write FName;
    property DisplayText: String read FDisplayText write FDisplayText;
    property KeyCode: Word read FKeyCode write FKeyCode;
  end;

  TAHMKeyProfile = class
  private
    FName: String;
    FDisplayText: String;
    FBindings: TList;
    FMappings: array[0..MAX_KEYCODE] of String;
  protected
    function GetCount: Integer;
    function GetBinding(Index: Integer): TAHMKeyBinding;
  public
    constructor Create(const Name: String);
    destructor Destroy; override;
    property Name: String read FName;
    property DisplayText: String read FDisplayText write FDisplayText;
    property Count: Integer read GetCount;
    property Binding[Index: Integer]: TAHMKeyBinding read GetBinding;
    function GetKeyAction(const KeyCode: Word): String;
    function GetKeyName(const KeyCode: Word): String;
    procedure AddKeyMapping(const KeyCode: Word; KeyName, ActionName: String);
  end;

  TAHMKeyProfileList = class(TStringList)
  private
  protected
  public
    destructor Destroy; override;
    function AddKeyProfile(const Name: String): TAHMKeyProfile;
    function GetKeyProfile(const Name: String): TAHMKeyProfile;
    procedure ClearProfiles;
  end;

  TAHMActionQueueItem = class
  private
    FContext: Cardinal;
    FFunction: String;
    FTargetName: String;
    FParameter: String;
  protected
    property Context: Cardinal read FContext write FContext;
  public
    property FunctionName: String read FFunction write FFunction;
    property TargetName: String read FTargetName write FTargetName;
    property Parameter: String read FParameter write FParameter;
    function Process: TAHMFunctionResult;
    procedure Assign(Source: TAHMActionQueueItem);
  end;

  TAHMActionQueue = class
  private
    FQueue: TList;
  protected
    function GetCount: Integer;
    function AddQueueItem: TAHMActionQueueItem;
    function InsertQueueItem(Index: Integer): TAHMActionQueueItem;
    function GetQueueItem(Index: Integer): TAHMActionQueueItem;
    procedure DeleteQueueItem(Index: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    function EnqueueAction(const ActionFunction, TargetName, Parameter: String): Boolean; overload;
    function EnqueueAction(Action: TAHMAction): Boolean; overload;
    function InsertItem(Item: TAHMActionQueueItem; Index: Integer; Context: Cardinal = 0): Boolean;
    procedure ProcessQueue;
    function ProcessQueueItem: Boolean;
    procedure ClearQueue;
    procedure ClearContext;
  end;

  TAHMActionManager = class
  private
    FThreadLock: TCriticalSection;
    FQueue: TAHMActionQueue;
    FKeyBindings: TAHMKeyBindingParser;
    FCurrentKeyProfile: TAHMKeyProfile;
    FNativeKeyProfile: TAHMKeyProfile;
    FKeyProfiles: TAHMKeyProfileList;
    FMacroContext: Cardinal;
  protected
    procedure SetKeyProfile(Name: String);
    function GetKeyProfile: String;
    procedure SetNativeKeyProfile(Name: String);
    function GetNativeKeyProfile: String;
    function GetActionsOutstanding: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    property KeyProfiles: TAHMKeyProfileList read FKeyProfiles;
    property KeyProfileName: String read GetKeyProfile write SetKeyProfile;
    property NativeKeyProfileName: String read GetNativeKeyProfile write SetNativeKeyProfile;
    property ActionsOutstanding: Boolean read GetActionsOutstanding;
    procedure LoadKeyBindings;
    function ProcessKeyPress(const KeyCode: Word): Boolean;
    function ProcessAction(const ActionName: String): Boolean; overload;
    function ProcessAction(const ActionName: String; Control: TAHMInteractiveControl): Boolean; overload;
    function EnqueueAction(const FunctionName, TargetName, Parameter: String): Boolean; overload;
    function EnqueueAction(Action: TAHMAction): Boolean; overload;
    function EnqueueMacro(Macro: TObject): Boolean;
    function IsQueueEmpty: Boolean;
    procedure UpdateQueuedActions;
  end;


implementation

uses Windows, SysUtils, ApplicationManager, InterfaceDescriptor, Screens,
     Timers, UIManager, Macros, TagNames, Logging;

//----------------------------------------------------------------------------//
constructor TAHMKeyProfile.Create(const Name: String);
begin
  inherited Create;

  FName := Name;
  FBindings := TList.Create;
end;

destructor TAHMKeyProfile.Destroy;
var
  i: Integer;
begin
  // Delete bindings objects
  for i := 0 to Pred(FBindings.Count) do
    TAHMKeyBinding(FBindings[i]).Free;
  FBindings.Free;

  inherited Destroy;
end;

function TAHMKeyProfile.GetCount: Integer;
begin
  Result := FBindings.Count;
end;

function TAHMKeyProfile.GetBinding(Index: Integer): TAHMKeyBinding;
begin
  if (Index >= 0) and (Index < FBindings.Count) then
    Result := TAHMKeyBinding(FBindings[Index])
  else
    Result := nil;
end;

function TAHMKeyProfile.GetKeyAction(const KeyCode: Word): String;
var
  iPos: Integer;
begin
  Result := FMappings[KeyCode];
  if Result <> '' then
  begin
    iPos := Pos(KEYNAME_SEPARATOR, Result);
    Result := Copy(Result, iPos + Length(KEYNAME_SEPARATOR), Length(Result));
  end;
end;

function TAHMKeyProfile.GetKeyName(const KeyCode: Word): String;
var
  iPos: Integer;
begin
  Result := FMappings[KeyCode];
  if Result <> '' then
  begin
    iPos := Pos(KEYNAME_SEPARATOR, Result);
    Result := Copy(Result, 1, Pred(iPos));
  end;
end;

procedure TAHMKeyProfile.AddKeyMapping(const KeyCode: Word; KeyName, ActionName: String);
var
  Binding: TAHMKeyBinding;
begin
  FMappings[KeyCode] := KeyName + KEYNAME_SEPARATOR + ActionName;

  // Save keybinding details in our list for manipulation later
  Binding := TAHMKeyBinding.Create;
  Binding.Name := ActionName;
  Binding.DisplayText := KeyName;
  Binding.KeyCode := KeyCode;
  FBindings.Add(Binding);
end;

//----------------------------------------------------------------------------//

destructor TAHMKeyProfileList.Destroy;
begin
  ClearProfiles;

  inherited Destroy;
end;

function TAHMKeyProfileList.AddKeyProfile(const Name: String): TAHMKeyProfile;
begin
  Result := TAHMKeyProfile.Create(Name);
  AddObject(Name, Result);
end;

function TAHMKeyProfileList.GetKeyProfile(const Name: String): TAHMKeyProfile;
var
  i: Integer;
begin
  i := IndexOf(Name);
  if (i <> -1) then
    Result := TAHMKeyProfile(Objects[i])
  else
    Result := Nil;
end;

procedure TAHMKeyProfileList.ClearProfiles;
var
  i: Integer;
begin
  // Clear all current key profile objects
  for i := 0 to Pred(Count) do
    TAHMKeyProfile(Objects[i]).Free;
  Clear;
end;

//----------------------------------------------------------------------------//

function TAHMActionQueueItem.Process: TAHMFunctionResult;
var
  oFunction: TAHMFunction;
begin
  // Lookup corresponding function object
  oFunction := ApplicationManagerInstance.FunctionDescriptor.FunctionList.GetFunction(FFunction);

  if oFunction = nil then
  begin
    Result := frFailed; // No function found, but we want to remove this item from q
    LogWarn('Attempted to process action queue item with unknown function: ' + FFunction);
  end
  else
    // Call corresponding function for this action
    if FTargetName = '' then
      Result := oFunction.Execute
    else
      Result := oFunction.Execute(FTargetName, FParameter);
end;

procedure TAHMActionQueueItem.Assign(Source: TAHMActionQueueItem);
begin
  FContext := Source.Context;
  FFunction := Source.FunctionName;
  FTargetName := Source.TargetName;
  FParameter := Source.Parameter;
end;

//----------------------------------------------------------------------------//

constructor TAHMActionQueue.Create;
begin
  inherited Create;

  FQueue := TList.Create;
end;

destructor TAHMActionQueue.Destroy;
begin
  ClearQueue;
  FQueue.Free;

  inherited Destroy;
end;

function TAHMActionQueue.GetCount: Integer;
begin
  Result := FQueue.Count;
end;

function TAHMActionQueue.AddQueueItem: TAHMActionQueueItem;
begin
  Result := TAHMActionQueueItem.Create;
  FQueue.Add(Result);
end;

function TAHMActionQueue.InsertQueueItem(Index: Integer): TAHMActionQueueItem;
begin
  Result := TAHMActionQueueItem.Create;
  FQueue.Insert(Index, Result);
end;

function TAHMActionQueue.GetQueueItem(Index: Integer): TAHMActionQueueItem;
begin
  if (Index >= 0) and (Index < FQueue.Count) then
    Result := TAHMActionQueueItem(FQueue.Items[Index])
  else
    Result := nil;
end;

procedure TAHMActionQueue.DeleteQueueItem(Index: Integer);
begin
  if (Index >= 0) and (Index < FQueue.Count) then
  begin
    TAHMActionQueueItem(FQueue.Items[Index]).Free;
    FQueue.Delete(Index);
  end;
end;

function TAHMActionQueue.EnqueueAction(const ActionFunction, TargetName, Parameter: String): Boolean;
var
  Item: TAHMActionQueueItem;
begin
  Result := False;

  if ActionFunction <> '' then
  begin
    Item := AddQueueItem;
    Item.FunctionName := ActionFunction;
    Item.TargetName := TargetName;
    Item.Parameter := Parameter;
    Result := True;
  end;
end;

function TAHMActionQueue.EnqueueAction(Action: TAHMAction): Boolean;
begin
  Result := False;

  if Assigned(Action) and (Action.ActionFunction <> '') then
    with AddQueueItem do
    begin
      FunctionName := Action.ActionFunction;
      TargetName := Action.TargetName;
      Parameter := Action.Parameter;

      if Assigned(Action.Owner.Owner) then
      begin
        // Perform "self" name substitution on actions
        if (TargetName = ATTR_VAL_SELF) then TargetName := Action.Owner.Owner.Name;

        if LogDebugEnabled then
          if Action.Owner.Owner is TAHMInteractiveControl then
            LogDebug('Control action "' + Action.Name + '" from ' + Action.Owner.Owner.Name +
                     ': fn=' + FunctionName + ', target=' + TargetName + ', param=' + Parameter)
          else if Action.Owner.Owner is TAHMTimer then
            LogDebug('Timer action "' + Action.Name + '" from ' + Action.Owner.Owner.Name +
                     ': fn=' + FunctionName + ', target=' + TargetName + ', param=' + Parameter)
          else
            LogDebug('Screen action "' + Action.Name + '" from ' + Action.Owner.Owner.Name +
                     ': fn=' + FunctionName + ', target=' + TargetName + ', param=' + Parameter);
      end
      else if LogDebugEnabled then
        LogDebug('Global action "' + Action.Name + ': fn=' + FunctionName +
                 ', target=' + TargetName + ', param=' + Parameter);

      Result := True;
    end;
end;

function TAHMActionQueue.InsertItem(Item: TAHMActionQueueItem; Index: Integer; Context: Cardinal = 0): Boolean;
begin
  Result := False;

  if Assigned(Item) and (Item.FunctionName <> '') then
  begin
    Item.Context := Context;
    with InsertQueueItem(Index) do Assign(Item);
    Result := True;
  end;
end;

procedure TAHMActionQueue.ProcessQueue;
begin
  // Process as many outstanding actions in queue as possible
  while ProcessQueueItem do;
end;

function TAHMActionQueue.ProcessQueueItem: Boolean;
var
  QueueItem: TAHMActionQueueItem;
begin
  // Set default result - item not processed
  Result := False;

  // Process first action in queue
  QueueItem := GetQueueItem(0);
  if Assigned(QueueItem) then
  begin
    case QueueItem.Process of
      frPartial: begin
                   // abandon queue processing - we'll resume this next time
                 end;
      frFailed:  begin
                   // cleanup corresponding failed items in queue
                   ClearContext;
                 end;
      else       begin
                   // success - delete completed item and continue processing
                   DeleteQueueItem(0);
                   Result := True; //TODO crash here
                 end;
    end;
  end;
end;

procedure TAHMActionQueue.ClearQueue;
var
  i: Integer;
begin
  for i := 0 to Pred(FQueue.Count) do
    TAHMActionQueueItem(FQueue.Items[i]).Free;
  FQueue.Clear;
end;

procedure TAHMActionQueue.ClearContext;
var
  i: Integer;
  Context: Cardinal;
begin
  // Get context for first action in queue
  Context := GetQueueItem(0).Context;

  // Check context to determine if item is part of macro
  if Context = 0 then
  begin
    // Not a macro - just delete this item
    DeleteQueueItem(0);
  end
  else
  begin
    // Delete all items in queue with same macro context. We also remove
    // any items with a lower context as this implies a nested macro
    for i := Pred(FQueue.Count) downto 0 do
      if GetQueueItem(i).Context <= Context then
        DeleteQueueItem(i);
  end;
end;

//----------------------------------------------------------------------------//

constructor TAHMActionManager.Create;
begin
  inherited Create;

  FQueue := TAHMActionQueue.Create;
  FKeyProfiles := TAHMKeyProfileList.Create;
  FKeyBindings := TAHMKeyBindingParser.Create;
  FThreadLock := TCriticalSection.Create;
end;

destructor TAHMActionManager.Destroy;
begin
  FQueue.Free;
  FKeyProfiles.Free;
  FKeyBindings.Free;
  FThreadLock.Free;

  inherited Destroy;
end;

procedure TAHMActionManager.SetKeyProfile(Name: String);
begin
  FCurrentKeyProfile := FKeyProfiles.GetKeyProfile(Name);
end;

function TAHMActionManager.GetKeyProfile: String;
begin
  if Assigned(FCurrentKeyProfile) then
    Result := FCurrentKeyProfile.Name
  else
    Result := '';
end;

procedure TAHMActionManager.SetNativeKeyProfile(Name: String);
begin
  FNativeKeyProfile := FKeyProfiles.GetKeyProfile(Name);
end;

function TAHMActionManager.GetNativeKeyProfile: String;
begin
  if Assigned(FNativeKeyProfile) then
    Result := FNativeKeyProfile.Name
  else
    Result := '';
end;

function TAHMActionManager.GetActionsOutstanding: Boolean;
begin
  // Return true if our queue is not empty
  Result := (FQueue.Count > 0);
end;

procedure TAHMActionManager.LoadKeyBindings;
begin
  // Clear any existing keybindings before we start
  FNativeKeyProfile := nil;
  FCurrentKeyProfile := nil;
  FKeyProfiles.ClearProfiles;

  // Parse XML to populate keybindings
  FKeyBindings.ParseXML(ApplicationManagerInstance.ConfigPath);
end;

function TAHMActionManager.ProcessKeyPress(const KeyCode: Word): Boolean;
var
  sAction: String;
begin
  Result := False;

  // Lookup keycode in custom key profile first
  if Assigned(FCurrentKeyProfile) then
    sAction := FCurrentKeyProfile.GetKeyAction(KeyCode)
  else
    sAction := '';

  // If no match found then try native key profile
  if (sAction = '') and Assigned(FNativeKeyProfile) then
    sAction := FNativeKeyProfile.GetKeyAction(KeyCode);

  // If we found a corresponding action then invoke it
  if sAction <> '' then
    Result := ProcessAction(sAction);
end;

function TAHMActionManager.ProcessAction(const ActionName: String): Boolean;
var
  oScreen: TAHMScreenLayout;
  oControl: TAHMInteractiveControl;
begin
  // Get focussed control from current screen layout
  oScreen := ApplicationManagerInstance.UIManager.CurrentScreen;
  if oScreen <> nil then oControl := oScreen.FocusControl
                    else oControl := nil;

  // Delegate action processing to method below
  Result := ProcessAction(ActionName, oControl);
end;

function TAHMActionManager.ProcessAction(const ActionName: String; Control: TAHMInteractiveControl): Boolean;
var
  oScreen: TAHMScreenLayout;
  lFinal: Boolean;
begin
  // Set default result - action not handled
  lFinal := False;

//TODO: maybe cause TryAcquire here so we identify deadlocks - then we can
// drop the action and log it instead  
  FThreadLock.Acquire;
  try
    // Allow plugins to react to this action before UI processing
    ApplicationManagerInstance.PluginManager.ProcessAction(ActionName);

    // Get current screen layout object
    oScreen := ApplicationManagerInstance.UIManager.CurrentScreen;

    if oScreen <> nil then
    begin
      // Allow specified control to handle action first
      if Control <> nil then
      begin
        lFinal := Control.Actions.InvokeAction(ActionName);

        // Add default press/cancel functions to control okay/back actions
        if not lFinal then
          if ActionName = AC_OKAY then EnqueueAction(FN_PRESS, Control.Name, '')
          else if ActionName = AC_BACK then EnqueueAction(FN_CANCEL, Control.Name, '');
      end;

      // If control action not final, delegate to screen layout actions
      if not lFinal then
        lFinal := oScreen.Actions.InvokeAction(ActionName);
    end;

    // If screen layout action not final, delegate to global actions
    if not lFinal then
      lFinal := ApplicationManagerInstance.ThemeManager.InterfaceDescriptor.ActionList.InvokeAction(ActionName);
  finally
    FThreadLock.Release;
  end;

  // Was action handled?
  Result := lFinal;
end;

function TAHMActionManager.EnqueueAction(const FunctionName, TargetName, Parameter: String): Boolean;
begin
  // Defer to action queue
  Result := FQueue.EnqueueAction(FunctionName, TargetName, Parameter);
end;

function TAHMActionManager.EnqueueAction(Action: TAHMAction): Boolean;
begin
  // Defer to action queue
  Result := FQueue.EnqueueAction(Action);
end;

function TAHMActionManager.EnqueueMacro(Macro: TObject): Boolean;
var
  i, Index: Integer;
begin
  Result := True;

  // Obtain a unique context identifier for this macro
  Inc(FMacroContext);

  // Get insertion point - macro action should be at front of queue, so skip it
  // but check for an empty queue scenario too to cope with designer macro test
  if FQueue.Count > 0 then Index := 1 else Index := 0;

  // Insert all functions in specified macro into action queue
  with TAHMMacro(Macro).Functions do
    for i := 0 to Pred(Count) do
      if FQueue.InsertItem(GetFunction(i).Action, Index, FMacroContext) then
        Inc(Index)
      else
      begin
        Result := False;
        Exit;
      end;
end;

function TAHMActionManager.IsQueueEmpty: Boolean;
begin
  Result := FQueue.Count = 0;
end;

procedure TAHMActionManager.UpdateQueuedActions;
begin
  FThreadLock.Acquire;
  try
    // Defer to queue manager
    FQueue.ProcessQueue;
  finally
    FThreadLock.Release;
  end;
end;


end.
